home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jtext.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  5.2 KB  |  178 lines
  1. # jtext.tcl - constrained interface to Text widget
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non-profit, noncommercial use.
  6.  
  7. # TO DO:
  8. #   logging
  9. #   integrate more tightly w/jtexttags (so can log tags as well)
  10.  
  11. ######################################################################
  12. # global variables:
  13. #
  14. global J_PREFS env
  15. if {! [info exists J_PREFS(typeover)]} {set J_PREFS(typeover) 1}
  16. #
  17. ######################################################################
  18.  
  19. ######################################################################
  20. # j:text:insert w text -
  21. #   insert text into w at insert point
  22. #   * detects if tags are being used and uses j:tag:insert_string 
  23. #   * handles deletion of selection if needed
  24. ######################################################################
  25. ### PROBLEM - checking J_PREFS(typeover) shouldn't really be here; it's
  26. ###   only appropriate if a user event is generating the text to insert
  27.  
  28. proc j:text:insert_string { w text } {
  29.   j:debug
  30.   global j_text
  31.   global j_tag
  32.   global J_PREFS
  33.   
  34.   # in typeover mode, all insertions replace selection:
  35.   if $J_PREFS(typeover) {
  36.     if [j:text:insert_touches_selection $w] {    ;# else might be off-screen!
  37.       j:text:delete $w sel.first sel.last
  38.     }
  39.   }
  40.   
  41.   # if we're using tagged-insertion...
  42.   if [info exists j_tag(tags,$w)] {        ;# using tagged text
  43.     j:tag:insert_string $w $text
  44.   } else {
  45.     set start [$w index insert]            ;# ????? USED ?????
  46.     $w insert insert $text
  47.     $w yview -pickplace insert
  48.   }
  49.   set j_text(dirty,$w) 1
  50. }
  51.  
  52. ######################################################################
  53. # j:text:move w index -
  54. #   move insert mark in w to index
  55. ######################################################################
  56.  
  57. proc j:text:move { w index } {
  58.   j:debug
  59.   $w mark set insert $index
  60.   $w yview -pickplace insert
  61. }
  62.  
  63. ######################################################################
  64. # j:text:delete w from to -
  65. #   delete from index from to index to in w
  66. ######################################################################
  67.  
  68. proc j:text:delete { w from to } {
  69.   j:debug
  70.   j:text:move $w $from
  71.   $w delete $from $to
  72.   set j_text(dirty,$w) 1
  73. }
  74.  
  75. ######################################################################
  76. # j:text:replace w from to string -
  77. #   replace range with string, preserving tags at from
  78. ######################################################################
  79.  
  80. proc j:text:replace { w from to string } {
  81.   set start [$w index $from]
  82.   set tags [$w tag names $from]
  83.   
  84.   $w mark set insert $from
  85.   $w delete insert $to
  86.   $w insert insert $string
  87.   
  88.   foreach tag [$w tag names $start] {
  89.     $w tag remove $tag $start insert
  90.   }
  91.   foreach tag $tags {
  92.     $w tag add $tag $start insert
  93.   }
  94.   set j_text(dirty,$w) 1
  95. }
  96.  
  97. ######################################################################
  98. # j:text:mark_dirty w - mark widget w as dirty (modified)
  99. ######################################################################
  100.  
  101. proc j:text:mark_dirty { w } {
  102.   global j_text
  103.   set j_text(dirty,$w) 1
  104. }
  105.  
  106. ######################################################################
  107. # j:text:mark_clean w - mark widget w as clean (unmodified)
  108. ######################################################################
  109.  
  110. proc j:text:mark_clean { w } {
  111.   global j_text
  112.   set j_text(dirty,$w) 0
  113. }
  114.  
  115. ######################################################################
  116. # j:text:is_dirty w -
  117. #   return 1 if w is dirty (modified) else 0
  118. #   (returns 1 if w hasn't been set dirty or clean)
  119. ######################################################################
  120.  
  121. proc j:text:is_dirty { w } {
  122.   global j_text
  123.   if [info exists j_text(dirty,$w)] {
  124.     return $j_text(dirty,$w)
  125.   } else {
  126.     return 1
  127.   }
  128. }
  129.  
  130. ######################################################################
  131. # j:selection_if_any - return selection if it exists, else {}
  132. #   this is from kjx@comp.vuw.ac.nz (R. James Noble)
  133. #   defined elsewhere, but copied here so the bindings libraries
  134. #   don't depend on jtkutils
  135. ######################################################################
  136.  
  137. if {[info procs j:selection_if_any] == {}} {
  138.   proc j:selection_if_any {} {
  139.     if {[catch {selection get} s]} {return ""} {return $s}
  140.   }
  141. }
  142.  
  143. ######################################################################
  144. # j:text:has_selection t -
  145. #   return true if selection made in t, else false
  146. ######################################################################
  147.  
  148. proc j:text:has_selection { t } {
  149.   set selrange [$t tag nextrange sel 1.0]
  150.   
  151.   if {"x$selrange" == "x"} {                    ;# returns {} if none
  152.     return 0
  153.   } else {
  154.     return 1
  155.   }
  156. }
  157.  
  158. ######################################################################
  159. # j:text:insert_touches_selection t -
  160. #   return true if selection exists in t and insert is inside or next
  161. #   to it (as will be the case if you just made the selection with
  162. #   the mouse)
  163. ######################################################################
  164.  
  165. proc j:text:insert_touches_selection { t } {
  166.   if {! [j:text:has_selection $t]} {        ;# no selection
  167.     return 0
  168.   }
  169.   if [$t compare insert < sel.first] {        ;# insert before selection
  170.     return 0
  171.   }
  172.   if [$t compare insert > sel.last] {        ;# insert after selection
  173.     return 0
  174.   }
  175.   return 1
  176. }
  177.  
  178.